home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL2.LZH / HEAPTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1984-08-21  |  2KB  |  61 lines
  1. program HeapTest (input, output) ;
  2.  
  3. {  This program demonstrates a bug in Turbo's version 2.  Put
  4.    10 integers on the stack, then release the stack and put
  5.    10 integers on the stact again.  In version 1.0, you will
  6.    get the same results - as it should be.  In version 2.0,
  7.    you will get different answers.  Apparently, the procedure
  8.    Release(HeapTop) in not working properly.   The procedure
  9.    ReleaseHeap is a replacement for Release (HeapTop) and seems
  10.    to work correctly.  }
  11.  
  12. type
  13.   IntegerPointer = ^integer ;
  14. var
  15.   Number  : ^integer ;
  16.   HeapTop : ^integer ;
  17.   Mem     :  real    ;
  18.  
  19. Procedure ReleaseHeap (AHeapPointer : IntegerPointer) ;
  20. var
  21.   i : integer ;
  22. begin
  23.   i := ((seg(heapptr^) - seg(AHeapPointer^)) shl 4) +
  24.         (ofs(heapptr^) - ofs(AHeapPointer^)) ;
  25.     FreeMem(AHeapPointer, i) ;
  26.   end ;
  27.  
  28. procedure report ;    { report memory available }
  29. begin
  30.   Mem := memAvail ;
  31.   if (Mem < 0) then Mem := 65536.0 + MemAvail ;
  32.   write ('MemAvail = ', Mem :7:0, ' paragraphs ', Mem * 16.0 :9:0, ' bytes') ;
  33. end ;
  34.  
  35. procedure FillTheHeap(xc,yc, Depth : integer) ;   { fill the heap to depth }
  36. var
  37.   n : integer ;
  38. begin
  39.   for n := 1 to Depth do
  40.     begin
  41.       New(Number) ;
  42.       Number^ := n ;
  43.       gotoxy(xc,yc) ;
  44.       report ;
  45.     end ;
  46.   end ;
  47.  
  48. begin   { main }
  49.   Mark(HeapTop) ;         { mark the top of the heap }
  50.   gotoxy(5,20) ;
  51.   report ;                { 1: report memory available }
  52.   FillTheHeap(5,21,10) ;  { 2: fill the heap with 10 integers }
  53.   ReleaseHeap(HeapTop) ;  { release the heap using the fix }
  54.   { release (HeapTop) ;  This does not work! }
  55.   gotoxy(5,22) ;
  56.   report ;                { 3: report memory available;  should be same as 1 }
  57.   FillTheHeap(5,23,10) ;  { 4: put 10 integers on again; should be same as 2 }
  58. end.
  59.  
  60.  
  61.